home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Night Owl 6
/
Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso
/
026a
/
tcal.zip
/
TCAL.PRG
< prev
next >
Wrap
Text File
|
1991-03-19
|
11KB
|
318 lines
************************************************************
* Name: TCAL.PRG *
* Desc: A popup calendar program. User can change *
* the month or year by pressing the PgUp, PgDn, *
* + , - *
* Author: Todd W. Lindley *
* Created: 3/12/91 *
* Version: 1.0 *
* Revisions: 3/91 - fixed display of dates past 12/1999. *
* - Made all variables private so that *
* they don't conflict with the calling *
* program. *
* *
* Usage: DO TCAL WITH row,col,"LARGE/SMALL",date *
* ROW = Upper left corner of calendar *
* COL = Upper left corner of calendar *
* TYPE = "LARGE" or "ANY OTHER STRING" *
* DATE = DATE() or CTOD("DATE") *
* *
* Ex: DO TCAL WITH 2,2,"LARGE",DATE() *
* Results: Displays a popup calendar at screen *
* coordinates 2,2 in large format *
* with the calendar displaying the *
* month and year of system date. *
* *
* Ex: DO TCAL WITH 2,2," ",CTOD("01/01/90") *
* Results: displays a popup calendar at screen *
* coordinates 2,2 in small format with *
* the calendar displaying January 1990 *
* *
* Notes: *
* - The program does not check the validity of *
* any parameters *
* - I have randomly checked some month/year combina- *
* tions and the calendars seem to be correct. *
* - The minimum row/col for the large calendar is 1,1 *
* - The minimum row/col for the small calendar is 2,2 *
* *
* Credits: *
* - I'd like to thank the author of SMALLCAL.prg for *
* allowing me to expand on his/her concept. *
* *
* A polite reminder... *
* *
* Since I have taken the time to develop this program, *
* please give me credit where credit is due should you *
* decide to use any part of this program in your own *
* public domain dBASE routines. *
* *
* Leave comments/suggestions via E-mail on the Ashton Tate *
* BBS to username SLICE. *
************************************************************
PARA start_row,start_col,size,tdate
SAVE SCREEN TO tcalscrn
PRIVATE ALL
STORE 0 TO month,year,day,firstday,lastday,skip_cols,last_col,col,row
STORE 0 TO curr,next,x,monthn,last_row,info_row
** SAVE A FEW SETTINGS
esc_stat=SET("ESCAPE")
talk_stat=SET("TALK")
attr_stat=SET("ATTRIBUTES")
SET ESCAPE OFF
SET TALK OFF
SET CURS OFF
SET COLOR OF NORMAL TO N/W
DO init
IF size="LARGE"
DO grid
ELSE
DO without_grid
ENDIF
DO calc
DO refresh
** MAIN LOOP - READS KEYBOARD
DO WHILE .T.
key=INKEY()
DO CASE
CASE key=27 && Esc
EXIT
CASE key=18 && PgUp
month=month+1
IF month>12
month=1
year=year+1
ENDIF
DO calc
DO refresh
CASE key=3 && PgDn
month=month-1
IF month<1
month=12
year=year-1
ENDIF
DO calc
DO refresh
CASE key=43 && "+"
year=year+1
IF year<0
year=1
ENDIF
DO calc
DO refresh
CASE key=45 && "-"
year=year-1
DO calc
DO refresh
ENDCASE
ENDDO
SET ESCAPE &esc_stat
SET TALK &talk_stat
SET CURS ON
SET COLOR TO &attr_stat
RESTORE SCREEN FROM tcalscrn
RETURN
PROCEDURE refresh
x=1
row=start_row+3
@info_row,start_col+1 CLEAR TO info_row,start_col+skip_cols*6
@info_row,start_col SAY monthn COLOR W+/W
@info_row,last_col-3 SAY STR(year,4,0) COLOR W+/W
IF size="LARGE"
DO clear_grid
ELSE
@start_row+3,start_col+1 CLEAR TO last_row-1,last_col-1
ENDIF
DO WHILE x<=lastday
@row,col SAY STR(x,2,0) && SLIGHTLY FASTER THAN PICT "99"
col=col+skip_cols
IF col>last_col
IF size="LARGE"
col=start_col+3
row=row+2
ELSE
col=start_col+2
row=row+1
ENDIF
ENDIF
x=x+1
ENDDO
RETURN
** INITIAL SET-UP
PROCEDURE init
size=UPPER(size)
** GET SOME INITIAL DATE INFORMATION
month=month(tdate)
year=YEAR(tdate)
day=DAY(tdate)
RETURN
PROCEDURE calc
** GET MONTH NAME
monthn=CMONTH(CTOD(STR(month,2,0)+"/01/91"))
** CALCULATE 1ST OF MONTH AND BEGINNING OF NEXT MONTH
beg=CTOD(STR(month,2,0)+"/"+"01/"+STR(year,4,0))
next=CTOD(STR(month+1,2,0)+"/"+"01/"+STR(year,4,0))
** CALCULATE # OF DAYS IN MONTH
firstday=DOW(beg)
lastday=next-beg
** STARTING DISPLAY COLUMN OF 1ST DAY OF MONTH
IF size="LARGE"
col=skip_cols*(firstday-1)+start_col+3
ELSE
col=skip_cols*(firstday-1)+start_col+2
ENDIF
RETURN
PROCEDURE grid
** EACH @ SAY WAS HARD CODED FOR SPEED IN DRAWING THE GRID.
** A DO WHILE COULD HAVE BEEN USED BUT WOULD HAVE BEEN TOO SLOW.
skip_cols=5
last_col=start_col+skip_cols*6+5
last_row=start_row+14
info_row=start_row-1
@start_row-1,start_col-1 CLEAR TO last_row+1,last_col+1
@start_row+1,start_col+2 SAY "Sun Mon Tue Wed Thu Fri Sat"
@start_row,start_col TO last_row,last_col
@start_row+2,start_col TO start_row+2,last_col
@start_row,start_col+skip_cols TO last_row,start_col+skip_cols*6
@start_row,start_col+skip_cols*2 TO last_row,start_col+skip_cols*5
@start_row,start_col+skip_cols*3 TO last_row,start_col+skip_cols*4
@start_row,start_col+skip_cols SAY CHR(194)
@start_row,start_col+skip_cols*2 SAY CHR(194)
@start_row,start_col+skip_cols*3 SAY CHR(194)
@start_row,start_col+skip_cols*4 SAY CHR(194)
@start_row,start_col+skip_cols*5 SAY CHR(194)
@start_row,start_col+skip_cols*6 SAY CHR(194)
@start_row+2,start_col SAY CHR(195)
@start_row+2,start_col+skip_cols SAY CHR(197)
@start_row+2,start_col+skip_cols*2 SAY CHR(197)
@start_row+2,start_col+skip_cols*3 SAY CHR(197)
@start_row+2,start_col+skip_cols*4 SAY CHR(197)
@start_row+2,start_col+skip_cols*5 SAY CHR(197)
@start_row+2,start_col+skip_cols*6 SAY CHR(197)
@start_row+2,last_col SAY CHR(180)
@start_row+4,start_col TO last_row-2,last_col
@start_row+6,start_col TO last_row-4,last_col
@start_row+8,start_col TO last_row-6,last_col
@start_row+4,start_col SAY CHR(195)
@start_row+4,start_col+skip_cols SAY CHR(197)
@start_row+4,start_col+skip_cols*2 SAY CHR(197)
@start_row+4,start_col+skip_cols*3 SAY CHR(197)
@start_row+4,start_col+skip_cols*4 SAY CHR(197)
@start_row+4,start_col+skip_cols*5 SAY CHR(197)
@start_row+4,start_col+skip_cols*6 SAY CHR(197)
@start_row+4,last_col SAY CHR(180)
@start_row+6,start_col SAY CHR(195)
@start_row+6,start_col+skip_cols SAY CHR(197)
@start_row+6,start_col+skip_cols*2 SAY CHR(197)
@start_row+6,start_col+skip_cols*3 SAY CHR(197)
@start_row+6,start_col+skip_cols*4 SAY CHR(197)
@start_row+6,start_col+skip_cols*5 SAY CHR(197)
@start_row+6,start_col+skip_cols*6 SAY CHR(197)
@start_row+6,last_col SAY CHR(180)
@start_row+8,start_col SAY CHR(195)
@start_row+8,start_col+skip_cols SAY CHR(197)
@start_row+8,start_col+skip_cols*2 SAY CHR(197)
@start_row+8,start_col+skip_cols*3 SAY CHR(197)
@start_row+8,start_col+skip_cols*4 SAY CHR(197)
@start_row+8,start_col+skip_cols*5 SAY CHR(197)
@start_row+8,start_col+skip_cols*6 SAY CHR(197)
@start_row+8,last_col SAY CHR(180)
@start_row+10,start_col SAY CHR(195)
@start_row+10,start_col+skip_cols SAY CHR(197)
@start_row+10,start_col+skip_cols*2 SAY CHR(197)
@start_row+10,start_col+skip_cols*3 SAY CHR(197)
@start_row+10,start_col+skip_cols*4 SAY CHR(197)
@start_row+10,start_col+skip_cols*5 SAY CHR(197)
@start_row+10,start_col+skip_cols*6 SAY CHR(197)
@start_row+10,last_col SAY CHR(180)
@start_row+12,start_col SAY CHR(195)
@start_row+12,start_col+skip_cols SAY CHR(197)
@start_row+12,start_col+skip_cols*2 SAY CHR(197)
@start_row+12,start_col+skip_cols*3 SAY CHR(197)
@start_row+12,start_col+skip_cols*4 SAY CHR(197)
@start_row+12,start_col+skip_cols*5 SAY CHR(197)
@start_row+12,start_col+skip_cols*6 SAY CHR(197)
@start_row+12,last_col SAY CHR(180)
@last_row,start_col SAY CHR(192)
@last_row,start_col+skip_cols SAY CHR(193)
@last_row,start_col+skip_cols*2 SAY CHR(193)
@last_row,start_col+skip_cols*3 SAY CHR(193)
@last_row,start_col+skip_cols*4 SAY CHR(193)
@last_row,start_col+skip_cols*5 SAY CHR(193)
@last_row,start_col+skip_cols*6 SAY CHR(193)
@last_row,last_col SAY CHR(217)
@start_row,last_col+2 FILL TO last_row+2,last_col+3 COLOR W/N
@last_row+2,start_col+1 FILL TO last_row+2,last_col+3 COLOR W/N
* @start_row-1,start_col+1 SAY "April"
@last_row+1,start_col+1 SAY "Month:"
@last_row+1,start_col+8 SAY "PgUp/PgDn" COLOR R/W
@last_row+1,last_col-9 SAY "Year:"
@last_row+1,last_col-3 SAY "+/-" COLOR R/W
RETURN
PROCEDURE clear_grid
@row,start_col+skip_cols-2 SAY " "
@row,start_col+skip_cols*2-2 SAY " "
@row,start_col+skip_cols*3-2 SAY " "
@row,start_col+skip_cols*4-2 SAY " "
@row,start_col+skip_cols*5-2 SAY " "
@row,start_col+skip_cols*6-2 SAY " "
@row,start_col+skip_cols*7-2 SAY " "
@last_row-1,start_col+skip_cols-2 SAY " "
@last_row-1,start_col+skip_cols*2-2 SAY " "
@last_row-1,start_col+skip_cols*3-2 SAY " "
@last_row-1,start_col+skip_cols*4-2 SAY " "
@last_row-1,start_col+skip_cols*5-2 SAY " "
@last_row-1,start_col+skip_cols*6-2 SAY " "
@last_row-1,start_col+skip_cols*7-2 SAY " "
@last_row-3,start_col+skip_cols-2 SAY " "
@last_row-3,start_col+skip_cols*2-2 SAY " "
@last_row-3,start_col+skip_cols*3-2 SAY " "
@last_row-3,start_col+skip_cols*4-2 SAY " "
@last_row-3,start_col+skip_cols*5-2 SAY " "
@last_row-3,start_col+skip_cols*6-2 SAY " "
@last_row-3,start_col+skip_cols*7-2 SAY " "
RETURN
PROCEDURE without_grid
skip_cols=4
last_col=start_col+skip_cols*6+4
last_row=start_row+9
info_row=start_row+1
@start_row-1,start_col-2 CLEAR TO last_row+1,last_col+2
@start_row,start_col-1 TO last_row,last_col+1 DOUBLE
@start_row+2,start_col+1 SAY "Sun Mon Tue Wed Thu Fri Sat"
@last_row+1,start_col-1 SAY "Month:"
@last_row+1,start_col+6 SAY "PgUp/PgDn" COLOR R/W
@last_row+1,last_col-7 SAY "Year:"
@last_row+1,last_col-1 SAY "+/-" COLOR R/W
@start_row+1,last_col+3 FILL TO last_row+2,last_col+4 COLOR W/N
@last_row+2,start_col FILL TO last_row+2,last_col+4 COLOR W/N
RETURN
